Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/0769B.ZIP/BASCSTAT.XTR

Text File | 1987-03-01 | 5KB | 238 lines

*:*********************************************************************
*:
*:      Program: BASCSTAT.XTR
*:
*:       System: Basic Statistics Compilation System
*:       Author: Lee Correll
*:    Copyright (c) 1987, Lee Correll
*:
*:    Called by: BASCSTAT.PRG
*:
*:        Calls: FINDHI_C--procedure
*:             : FINDHI_N--procedure
*:
*:         Uses: EXTRA.DBF
*:             : XTRA1.DBF
*:
*: Documented: 3/1/87       1:01                   SNAP! version 1.72
*:*********************************************************************
PROCEDURE character
SELECT 1
DO findhi_c WITH fn,high
?"Counting Responses = 1"
COUNT ALL FOR UPPER(&fn)="A" .OR. &fn="1" TO na
?"Counting Responses = 2"
COUNT ALL FOR UPPER(&fn)="B" .OR. &fn="2" TO nb
IF high >= 3 THEN
    ?"Counting Responses = 3"
    COUNT ALL FOR UPPER(&fn)="C" .OR. &fn="3" TO nc
ENDIF
IF high >= 4 THEN
    ?"Counting Responses = 4"
    COUNT ALL FOR UPPER(&fn)="D" .OR. &fn="4" TO nd
ENDIF
IF high >= 5 THEN
    ?"Counting Responses = 5"
    COUNT ALL FOR UPPER(&fn)="E" .OR. &fn="5" TO ne
ENDIF
IF high = 6 THEN
    ?"Counting Responses = 6"
    COUNT ALL FOR UPPER(&fn)="F" .OR. &fn="6" TO nf
ENDIF
RETURN

PROCEDURE numeric
PRIVATE nz
SELECT 1
DO findhi_n WITH fn,high
?"Counting Responses = 1"
COUNT ALL FOR &fn = 1 TO na
?"Counting Responses = 2"
COUNT ALL FOR &fn = 2 TO nb
IF high >= 3 THEN
    ?"Counting Responses = 3"
    COUNT ALL FOR &fn = 3 TO nc
ENDIF
IF high >= 4 THEN
    ?"Counting Responses = 4"
    COUNT ALL FOR &fn = 4 TO nd
ENDIF
IF high >= 5 THEN
    ?"Counting Responses = 5"
    COUNT ALL FOR &fn = 5 TO ne
ENDIF
IF high = 6 THEN
    ?"Counting Responses = 6"
    COUNT ALL FOR &fn = 6 TO nf
ENDIF
RETURN

PROCEDURE findhi_c
PARAMETERS feild,hi
high = " "
hi   = 0

* Step one - determine if we are using numbers or letters

?"Finding Maximum Value"
GO TOP
DO WHILE LEN(TRIM(&feild))=0
    SKIP
ENDDO
y = &feild
z = UPPER(y)
IF z >= "A" .AND. z <= "F" THEN
    high  = "A"                  && using letters
ELSE
    high  = "1"                  && using numbers
ENDIF

* Step two - find the highest one used

GO TOP
DO CASE
CASE high = "A"
    DO WHILE .NOT. EOF()
        IF UPPER(&feild) > high THEN
            high = UPPER(&feild)
        ENDIF
        SKIP
    ENDDO
    hi = ASC(high)-ASC("A")+1
CASE high = "1"
    DO WHILE .NOT. EOF()
        IF UPPER(&feild) > high THEN
            high = UPPER(&feild)
        ENDIF
        SKIP
    ENDDO
    hi = ASC(high)-ASC("1")+1
ENDCASE
RETURN

PROCEDURE findhi_n
PARAMETERS feild,hi
hi   = 0
?"Finding Maximum Value"
GO TOP
DO WHILE .NOT. EOF()
    IF &feild > hi THEN
        hi = &feild
    ENDIF
    SKIP
ENDDO
RETURN

PROCEDURE displine
PARAMETERS line,letter,num1,num2,num3,num4
@ line,04 SAY letter
@ line,19 SAY STR(num1,3,0)
@ line,31 SAY STR((num1/num2)*100,5,2)
IF num4 = 100 THEN
    @ line,43 SAY "Missing"
ELSE
    @ line,43 SAY STR((num1/num3)*100,5,2)
    num4 = num4 + ((num1/num3)*100)
ENDIF
@ line,56 SAY STR(num4,5,2)
RETURN

PROCEDURE AVERAGE
avg = na + nb * 2 + nc * 3 + nd * 4 + ne * 5 + nf * 6
avg = avg / valid
RETURN

PROCEDURE stdev
SET DECIMALS TO 9
SELECT 1
GO TOP
stddev = 0
IF ft = "Character" THEN
    DO WHILE .NOT. EOF()
        IF VAL(&fn) <> 0 .AND. VAL(&fn) <= high THEN
            stddev = stddev + (VAL(&fn)-avg)^2
        ENDIF
        SKIP + 1
    ENDDO
ELSE
    DO WHILE .NOT. EOF()
        IF &fn <> 0 .AND. &fn <= high THEN
            stddev = stddev + ((&fn)-avg)^2
        ENDIF
        SKIP + 1
    ENDDO
ENDIF
stddev = stddev / valid
stddev = SQRT(stddev)
SET DECIMALS TO 2
SELECT 2
RETURN

PROCEDURE median
PRIVATE A
SELECT 1
COPY TO extra FIELDS &fn
SORT TO xtra1 ON &fn
ERASE extra.dbf
SELECT 3
USE xtra1
* Step one - Even or Odd number of records
DO CASE
CASE valid/2 = INT(valid/2)
    A = valid/2
    GO TOP
    SKIP +A
    IF ft = "Character" THEN
        medn = VAL(&fn)
    ELSE
        medn = fn
    ENDIF
    SKIP +1
    IF ft = "Character" THEN
        medn = medn + VAL(&fn)
    ELSE
        medn = medn + fn
    ENDIF
    medn = medn / 2
CASE valid/2 <> INT(valid/2)
    A = INT(valid/2)+1
    GO TOP
    SKIP +A
    IF ft = "Character" THEN
        medn = VAL(&fn)
    ELSE
        medn = fn
    ENDIF
ENDCASE
USE
ERASE xtra1.dbf
SELECT 2
RETURN

PROCEDURE mode1
PRIVATE nz
omde = 1
nz   = na
IF nb > na THEN
    omde= 2
    nz = nb
ENDIF
IF nc > nz THEN
    omde= 3
    nz = nc
ENDIF
IF nd > nz THEN
    omde= 4
    nz = nd
ENDIF
IF ne > nz THEN
    omde= 5
    nz = ne
ENDIF
IF nf > nz THEN
    omde= 6
ENDIF
RETURN

*: EOF: BASCSTAT.XTR